COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE	FINDER
C00006 00003		SUBTTL	DATA STORAGE
C00011 00004		SUBTTL	ALARUMS AND DIVERSIONS
C00013 00005		SUBTTL	VARIOUS FLAVORS OF OUTPUT STUFF
C00021 00006		SUBTTL	IF THE USER IS LOGGED IN ALREADY
C00023 00007		SUBTTL	FIND
C00025 00008		SUBTTL	THINK ABOUT PRIVILEGES
C00031 00009		SUBTTL	LIST USER DATUM.
C00035 00010		SUBTTL	MODIFY A USER'S INFO ENTRY
C00039 00011		SUBTTL	READ UFD
C00040 00012		SUBTTL	DREAD	READ A WHOLE FILE IN DUMP MODE.
C00043 00013		SUBTTL	INITIALIZE
C00046 00014		SUBTTL	DO-ALL SCANNER. MAXIMUM UTILITY AND INTOLERANCE.
C00051 ENDMK
C⊗;
TITLE	FINDER

	EXTERN	JOBFF,JOBREL,JOBDDT

;ASSEMBLY FLAGS

PTYBIT←←4000		;LINE CHAR. PTY LINE
IMPBIT←←1000		;THIS AND PTYBIT MEANS THIS IS AN IMP
JLOG←←10000	;JOB IS LOGGED IN. BIT IN JBTSTS
PDLEN←←20		;SIZE OF PUSH-DOWN LIST
UFDN←←4		;LENGTH OF UFD ENTRY
MFDTRK←←1		;TRACK WHERE MFD IS FOUND
INFON←←5		;LENGTH OF INFO DATA AREA
INFBAS←←13		;LOCATION OF INFO DATA IN RETRIEVAL

PTYJOB←←270	;CELL TO PEEK IN TO FIND PTYJOB
TTYNUM←←221	;CELL TO GET DATA ABOUT THE NUMBER OF TELETYPES.
PRJPRG←←211	;POINTER TO PRJPRG IN SYSTEM

;	INDICIES TO INFON
	LOSPSW←←0		;PASSWORD INDEX
	PRVBIT←←1		;USER'S PRIV. BITS
	LASDAT←←2		;LAST DATE WHEN HE WAS LOGGED IN
	DEFPRO←←3		;DEFAULT PROTECTION

DSK←←17		;READ/WRITE CHANNEL FOR DSK.
DMP←←16		;DISK FOR DUMP MODE
TTY←←15

DPYBIT←←400000	;III BIT IN GETLIN
CTYBIT←←200000	;CTY
DDBIT←←20000	;DD BIT IN GETLIN

CTLVF←←40			;FLAG TO REMEMBER CTLV MODE
PTYLIN←←200		;SET IF PTY
CTYLIN←←400		;SET IF CTY LOGIN
DPYLIN←←1000		;SET IF EITHER III OR DD DISPLAY
NEGF←←10000		;SET TO FLUSH A PRIVILEGE
NODATE←←20000		;SET TO PREVENT LASDAT UPDATE
NOTNOW←←40000		;SET IF NOLOGIN IN SYSTEM ≠ 0
IMPLIN←←100000		;SET IF THIS IS AN IMP

;PRIVILEGE BITS
INFPRV←←20			;ACCESS TO INFO DATA IN UFD
PROPRV←←100000		;RENAME THRU FILE SYSTEM IS OK
REAPRV←←40000		;READ THRU FILE SYSTEM IS OK
WRTPRV←←20000		;WRITE THRU FILE SYSTEM IS OK
DAWPRV←←200000		;DISK ABSOLUTE WRITE PRIVILIGE
LUPPRV←←1
LOGPRV←←DAWPRV!INFPRV!PROPRV!REAPRV!WRTPRV!LUPPRV	;PRIVILEGES FOR LOGIN

FL←0 ↔ A←1 ↔ B←2 ↔ C←3 ↔ D←4 ↔ W←5 ↔ X←6 ↔ Y←7 ↔ Z←10 ↔ K←11
L←12 ↔ M←13 ↔ N←14 ↔ TAC←15 ↔ TAC1←16 ↔ P←17


	LOC	137
	13			;JOBVERSION
	RELOC	0
	SUBTTL	DATA STORAGE


LPBITS:	XWD	400000,'PRI'		;PRIVILEGE PRIVILEGE
	XWD	200000,'DAW'		;DISK ABSOLUTE WRITE
	XWD	100000,'PRO'		;FILE SYSTEM RENAME 
	XWD	 40000,'REA'		;FILE SYSTEM READ
	XWD	 20000,'WRT'		;FILE SYSTEM WRITE
	XWD	 10000,'UDP'		;UDP EXTENDED ACCESS
	XWD	  4000,'UPG'		;SELECT OTHER III'S
	XWD	  2000,'MES'		;TTYMES UUO
	XWD	  1000,'KIL'		;CONSOLE KILL COMMAND
	XWD	   400,'DEV'		;DET/ATT DEVICE
	XWD	   200,'SEG'		;SEGMENT ACCESS PRIV
	XWD	   100,'SSL'		;SET SYSTEM SERVICE LEVEL TABLE
	XWD	    40,'ACW'		;ABSOLUTE CORE WRITE (SETPR2)
	XWD	    20,'INF'		;DISK ABSOLUTE READ
	XWD	    10,'TLK'		;CAN DO TALKS
	XWD          4,'FBW'		;FAST BAND WRITE OR WRONG
	XWD	     2,'XGP'		;XGP FONT ACCESS.
	XWD	     1,'LUP'		;The Not Telnet Privilege
LPBLL←←.-LPBITS

RPBITS:					;RIGHT SIDE BITS.
RPBLL←←.-RPBITS
ALLPRV:	777775,,0			;THESE ARE THE LEGAL ONES FOR USERS
					;NOTE: XGPPRV ISN'T ALLOWED.

GOD:	'  1  1'

CRLF:	BYTE(7)15,12

MONTHT:	SIXBIT/JAN/
	SIXBIT/FEB/
	SIXBIT/MAR/
	SIXBIT/APR/
	SIXBIT/MAY/
	SIXBIT/JUN/
	SIXBIT/JUL/
	SIXBIT/AUG/
	SIXBIT/SEP/
	SIXBIT/OCT/
	SIXBIT/NOV/
	SIXBIT/DEC/
MONTLG←←.-MONTHT		;LENGTH OF MONTH TABLE

FILBLK←←2			;NUMBER OF BLOCKS OF THE FILE TO READ
				;WARNING!!! FILBLK MUST BE AT LEAST 2.
FILENG←←FILBLK*200		;NUMBER OF WORDS TO READ

INRD:	'GODMOD'		;FOR MTAPE TO READ INFO AREA
	1			;READ
	IOWD	40,FILE0	;IOWD FOR TRANSFER
INRD1:	0			;XWD RECORD,TRACK NUMBER

RDINFO:	'GODMOD'		;READ RETRIEVAL INFO
	10
	INFOS

WRINFO:	'GODMOD'		;WRITE RETRIEVAL INFO
	11
	INFOS

DEBUG:	0
DSKBUF:	BLOCK	3		;BUFFER HEADER
TTYOBF:	BLOCK	3		;BUFFER HEADER FOR CHANNEL "TTY"
TTYBUF:	0			;ADDRESS OF BUFFERS FOR USER CONSOLE
DISKBF:	0			;PLACE TO PUT DISK BUFFERS
NOW:	0			;SET TO DATE,,TIME IN MINUTES WHEN STARTED
DBLOCK:	
USER:	0			;USERS PPN
USRBIT:	0			;USER PRIVILEGE BITS
LBLEN←←.-DBLOCK
UFDLOK:	BLOCK	5		;4 WORDS FOR UFD RENAME BLOCK, 5TH FOR FLAG
PDLIST:	BLOCK	PDLEN		;PUSH DOWN LIST

GOTUFD:	0			;HAS USER ALREADY GOT A UFD?
INFOS:	BLOCK	INFON
PHRASE:	BLOCK	2		;PROJECT/WD 1, PROGRAMMER/WD 2.
MFDPT:	0
LPTBUF:	0

BUF:				;THIS IS A PUN. USED FOR READING LOG.LOG
FILE0:	BLOCK	40		;BLOCK FOR THE RETRIEVAL
FILE:	BLOCK 	FILENG		;BLOCK FOR FIRST BLOCK OF FILE
MUDPTR:	BLOCK	2

YEAR:	0
TIME:	0
FILLCH:	0
BASECH:	0
RAD:	TZAP:	0		;RADIX FOR ALLRAD PRINTER.
; TZAP IS LAST WORD ZEROED BY BLT AT START
LASLOG:	0
DAYTAB:	ASCIZ	/Sunday/
	ASCIZ	/Monday/
	ASCIZ	/Tuesday/
	ASCIZ	/Wednesday/
	ASCIZ	/Thursday/
	ASCIZ	/Friday/
	ASCIZ	/Saturday/
CKCODE:	-1			;SET TO ZERO IF LOSER IS NOT AUTHORIZED.

PATCH:	BLOCK	20
PATCH1:	BLOCK	20
PATCH2:	BLOCK	20

JOBQUE:	0
JBTSTS:	0
JOBN:	0
SVSTAT:	0
LINCHR:	0			;TTY LINE CHARACTERISTICS WORD
PTYTJB:	0			;JOB NUMBER OF CONTROLLER IF THIS IS A PTY.
PTYPPN:	0			;PPN OF CONTROLLING JOB FOR PTY LINES.

CHTEMP:	0
TYIBUF:	BLOCK	50		;BUFFER FOR SPECIAL HACK MODE
	SUBTTL	ALARUMS AND DIVERSIONS
NODISK:	OUTSTR	[ASCIZ	/CAN'T INIT THE DISK
/]
	EXIT		
NOCORE:	OUTSTR	[ASCIZ/Core uuo failed!
/]
	EXIT		
UFDEER:	OUTSTR	[ASCIZ/Can't make your new ufd
/]
	EXIT		

UFDLER:	OUTSTR	[ASCIZ/UFD Lookup failed. /]
	CAIL	B,UERRTL
	MOVEI	B,0		;LOSER LOSER
	OUTSTR	@UERRTB(B)	;GIVE MESSAGE FROM TABLE
	OUTSTR	CRLF
	EXIT		
UERRTB:	[ASCIZ/UNKNOWN STATUS/]
	[ASCIZ/ILLEGAL PPN/]
	[ASCIZ/PROTECTION/]
	[ASCIZ/RENAME ERROR/]
	[ASCIZ/RENAME ERROR/]
	[ASCIZ/RENAME ERROR/]
	[ASCIZ/NAMES CONFLICT/]
	[ASCIZ/NO INIT/]
	[ASCIZ/BAD MFD ENTRY/]
	[ASCIZ/UFD GARBAGED/]
UERRTL←←.-UERRTB


NOUFD:	OUTSTR	[ASCIZ/I CAN'T FIND THE UFD THAT I JUST MADE FOR YOU!
/]
	EXIT
	SUBTTL	VARIOUS FLAVORS OF OUTPUT STUFF
;	OUTPUT ROUTINES. ALL ROUTINES USE PUTCHR TO TYPE
;	ONE CHARACTER ON CHANNEL TTY.  THIS CHANNEL IS INITIALLY
;	THE USER CONSOLE, BUT MAY BE SWITCHED TO THE LPT
;	FOR THE L COMMAND FROM [1,2] USER MODE.

LPTRLS:	SKIPN	A,LPTBUF	;ASSUME LPT BUFFER IS AT HIGH CORE
	POPJ	P,		;NO BUFFERS-NO RELEASE
	MOVEM	A,JOBFF		;RECLAIM THE SPACE
	CLOSE	TTY,		;FORCE OUT ALL THE DATA
	SETZM	LPTBUF		;ZERO THE BUFFER POINTER
TTYINI:	INIT	TTY,0		;GET THE TTY
	'TTY   '		;USER CONSOLE
	XWD	TTYOBF,0	;OUTPUT ONLY
	HALT			;THIS CAN'T HAPPEN
	SKIPN	A,TTYBUF	;DID WE HAVE BUFFERS ONCE BEFORE?
	JRST	TTYIN1		;NOPE. MAKE NEW ONES
	EXCH	A,JOBFF		;YES RESET JOBFF
	OUTBUF	TTY,2		;RESET THE OLD BUFFERS
	MOVEM	A,JOBFF		;RESTORE JOBFF
	POPJ	P,		;ALL DONE
TTYIN1:	MOVE	A,JOBFF		;GET JOBFF
	MOVEM	A,TTYBUF
	OUTBUF	TTY,2		;GET SOME BUFFERS
	POPJ	P,		;RETURN

LPTINI:	INIT	TTY,0		;GET THE LPT ON CHANNEL NAMED TTY
	'LPT   '
	XWD	TTYOBF,0
	JRST	LPTIN1		;NO LPT AVAILABLE
	MOVE	A,JOBFF		;GET THE PRESENT JOBFF
	MOVEM	A,LPTBUF	;SAVE AS ADDRESS OF THE LPT BUFFER
	OUTBUF	TTY,2		;GET SOME BUFFERS
	JRST	CPOPJ1		;SKIP RETURN
LPTIN1:	OUTSTR	[ASCIZ/LPT IS NOT AVAILABLE.
/]
	POPJ	P,		;RETURN

PUTCHR:	SKIPN	LPTBUF		;ONLY DO IT THE HARD WAY FOR LPT
	JRST	PUTCH2
	SOSG	TTYOBF+2	;DECREMENT CHARACTER COUNT
	OUTPUT	TTY,		;WRITE A BUFFER
	IDPB	A,TTYOBF+1	;DEPOSIT CHARACTER IN BUFFER
	POPJ	P,

PUTCH2:	TTCALL	1,A		;WRITE ONE CHARACTER
	POPJ	P,

PUTSTR:	HRLI	B,440700	;7 BIT BYTE POINTER IN B
PUTST1:	ILDB	A,B		;LOAD A BYTE
	JUMPE	A,CPOPJ		;RETURN IF NULL
	PUSHJ	P,PUTCHR	;WRITE CHARACTER
	JRST	PUTST1		;LOOP

DECOUT:	SKIPA	B,[12]		;THE BASE
OCTOUT:	MOVEI	B,10		;BASE FOR OCTAL
	MOVEM	B,RAD
	SETZ	TAC,
	MOVEI	B,"0"
	MOVEM	B,BASECH	;SAVE BASE CHARACTER
ALLRAD:	IDIV	A,RAD		;DIVIDE BY THE RADIX
	HRLM	B,(P)		;SAVE REMAINDER
	SUBI	TAC,1		;DECREMENT THE CHARACTER COUNT
	JUMPE	A,ALLRD1	;JUMP IF DEEP ENOUGH
	PUSHJ	P,ALLRAD	;NO. MAKE A RECURSIVE CALL
	JRST	ALLRD3		;BUBBLE UP FROM RECURSION
ALLRD1:	MOVE	A,FILLCH	;GET THE FILL CHARACTER
ALLRD2:	SOJL	TAC,ALLRD3	;ALL DONE WITH FILL?
	PUSHJ	P,PUTCHR	;NO. WRITE ONE CHARACTER
	JRST	ALLRD2		;LOOP
ALLRD3:	HLRZ	A,(P)
	ADD	A,BASECH	;ADD THE BASE CHARACTER
	JRST	PUTCHR		;WRITE A CHARACTER AND POPJ.

TWODIG:	MOVEI	B,12
	MOVEM	B,RAD
	MOVEI	TAC,2
	MOVEI	B,"0"
	MOVEM	B,FILLCH
	MOVEM	B,BASECH
	JRST	ALLRAD

SIXOUT:	MOVE	TAC1,A		;GET THE SIXBIT INTO TAC1
SIXOU1:	JUMPE	TAC1,CPOPJ	;RETURN IF ALL DONE
	SETZ	TAC,		;ZERO IN TAC
	LSHC	TAC,6		;MOVE CH. INTO TAC
	MOVEI	A," "(TAC)	;MAKE CHARACTER IN A
	PUSHJ	P,PUTCHR
	JRST	SIXOU1		;LOOP

TYFIL:	PUSHJ	P,SIXOUT	;TYPE FILE NAME FROM A
	HLLZ	B,B		;GET THE EXTENSION
	JUMPE	B,CPOPJ		;NO EXTENSION
	MOVEI	A,"."
	PUSHJ	P,PUTCHR
	MOVE	A,B
	JRST	SIXOUT		;WRITE MORE

TYPPN:	HRLZ	B,A		;GET THE PROG
	PUSH	P,B		;SAVE
	HLLZ	B,A		;GET THE PROJ
	MOVEI	A,"["
	PUSHJ	P,PUTCHR
	MOVE	A,B
	PUSHJ	P,SIXOUT
	MOVEI	A,","
	PUSHJ	P,PUTCHR
	POP	P,A
	PUSHJ	P,SIXOUT
	MOVEI	A,"]"
	JRST	PUTCHR
TDOUT:	JUMPE	A,TDOUTX		;JUMP IF NO ENTRY HERE
	HLRZ	B,A			;GET THE DATE
	HRRZ	A,A			;GET THE TIME
	PUSH	P,A			;SAVE TIME
	IDIVI	B,37			;GET THE DAY IN C
	MOVEI	A,1(C)			;SAVE DAY OF MONTH
	IDIVI	B,14			;GET MONTH IN C
	ADDI	B,100
	MOVEM	B,YEAR			;SAVE YEAR
	PUSHJ	P,DECOUT		;WRITE DECIMAL
	MOVEI	A,"-"			;WRITE -
	PUSHJ	P,PUTCHR
	MOVE	A,MONTHT(C)		;GET THE NAME OF MONTH
	PUSHJ	P,SIXOUT
	MOVEI	A,"-"
	PUSHJ	P,PUTCHR
	MOVE	A,YEAR
	PUSHJ	P,DECOUT
	MOVEI	A,11
	PUSHJ	P,PUTCHR
	POP	P,A
	IDIVI	A,74			;HOURS IN A,MINUTES IN B
	PUSH	P,B
	PUSHJ	P,TWODIG
	POP	P,A
	JRST	TWODIG		;WRITE TWO MORE AND RETURN
TDOUTX:	MOVEI	A,11			;GET A TAB
	PUSHJ	P,PUTCHR		;WRITE ONE
	JRST	PUTCHR			;WRITE TWO
LOGON:	TRNE	FL,PTYLIN
	POPJ	P,		;NOTHING FOR PTY'S
	HLRZ	A,NOW		;GET THE CURRENT DATE
	IDIVI	A,37
	MOVEI	D,1(B)		;GET DAY OF MONTH IN D
	IDIVI	A,14		;YEAR IN A, MONTH IN B
	TRNN	A,3		;SKIP IF NOT LEAP YEAR
	CAIGE	B,2		;SKIP IF AFTER FEBRUARY ON LEAP YEAR
	SUBI	D,1		;NOT LEAP YEAR & PAST FEB. SUBTRACT 1
	ADDI	A,3		;JAN 1, 1964 WAS A WEDNESDAY
	ADD	D,A
	LSH	A,-2		;DIV BY 4 MAKE # OF LEAP YEARS SINCE JAN 64
	ADD	A,D		;BASE FOR THIS DAY AND YEAR
	MOVE	D,[033614625035];MONTH OFFSET WORD
	ROT	D,1(B)
	ROT	D,1(B)
	ROT	D,1(B)
	ANDI	D,7
	ADD	A,D
	IDIVI	A,7
	LSH	B,1		;DOUBLE THE INDEX VALUE
	OUTSTR	DAYTAB(B)
	OUTSTR	[ASCIZ/	/]	;TYPE A TAB
	MOVE	A,NOW
	PUSHJ	P,TDOUT		;TYPE IT
	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR
	CLOSE	TTY,		;FORCE IT OUT
	POPJ	P,		;RETURN

OCTIN0:	OUTSTR	[ASCIZ/ILLEGAL CHARACTER IN OCTAL SCAN.  PLEASE TRY AGAIN
/]
OCTIN:	SETZB	A,C		;CLEAR SUCCESS FLAG, ACCUMULATOR
OCTIN1:	INCHWL	B
	CAIN	B,15
	JRST	OCTIN1
	CAIN	B,12
	POPJ	P,		;C>0 IF ANYTHING SEEN
	JUMPL	C,OCTIN0	;ONLY CRLF ALLOWED AFTER ?
	JUMPG	C,OCTIN2	;? NOT ALLOWED AFTER DIGIT
	CAIN	B,"?"
	SOJA	C,OCTIN1	;C<0 FOR HELP REQUEST
OCTIN2:	CAIL	B,"0"
	CAILE	B,"7"
	JRST	OCTIN0		;ERROR
	LSH	A,3
	ADDI	A,-"0"(B)
	AOJA	C,OCTIN1	;LOOP
	SUBTTL	IF THE USER IS LOGGED IN ALREADY
USRMOD:	SETZM	LPTBUF
	PUSHJ	P,TTYINI
UCON:	PUSHJ	P,RMFD		;READ THE MFD
UCMSG:	OUTSTR	[ASCIZ/
E	EXIT
M	MODIFY
F	FIND USERS
P	PRIVILEGE NAMES
/]
	SKIPE	JOBDDT
	OUTSTR	[ASCIZ/$	DDT
/]
UC:	OUTSTR	[ASCIZ/*/]
	INCHWL	A
	CLRBFI
	CAIL	A,"a"
	CAILE	A,"z"
	JRST	.+2
	TRZ	A,40
	MOVSI	B,-UCTL
	HLRZ	C,UCT(B)
	CAME	A,C
	AOBJN	B,.-2
	JUMPL	B,UC1
	OUTSTR	[ASCIZ/?
/]
	JRST	UC

UC1:	HRRZ	C,UCT(B)
	PUSHJ	P,(C)
	JRST	UC

UCT:	XWD	"E",UEXIT
	XWD	12,CPOPJ
	XWD	15,CPOPJ
	XWD	"F",FIND
	XWD	"M",MODIFY
	XWD	"$",DDTGO
	XWD	175,DDTGO
	XWD	"H",UCTYPE
	XWD	"P",PTYPE	;TYPE PRIVILEGE NAMES
	XWD	"T",ITYPE	;TYPE STUFF
	XWD	"L",ILIST	;LIST STUFF
UCTL←←.-UCT


DDTGO:	SKIPN	JOBDDT
	JRST	NODDT
	OUTSTR	[ASCIZ/(DDT)
/]
	JRST	@JOBDDT

UCTYPE:	POP	P,(P)
	JRST	UCMSG

NODDT:	OUTSTR	[ASCIZ/NO DDT
/]
	POPJ	P,

UEXIT:	EXIT	1,
	SUBTTL	FIND
FIND:	OUTSTR	[ASCIZ/USER = /]
	PUSHJ	P,SIXIN			;GET SOME SIXBIT
	HRRZM	B,PHRASE		;SAVE PART 1
	CAIN	A,","			;MUST SEE A COMMA
	JRST	FIND0			;COMMA
	CAIE	A,12			;NOT COMMA: NEED LF
	JRST	FNDERR			;I DON'T UNDERSTAND
	JRST	FIND0A			;OK, B WILL BE USER NAME
FIND0:	PUSHJ	P,SIXIN			;GET ANOTHER
	HRL	B,PHRASE		;GET THE OTHER PART
FIND0A:	MOVEM	B,USER
	CAIE	A,12
	JRST	FNDERR
	MOVE	D,MFDPT
	AOJGE	D,CPOPJ
	PUSH	P,LPTBUF
	SETOM	LPTBUF
FIND1:	SKIPN	A,USER			;LOAD THE MASK
	JRST	FIND2			;ZERO MASK: TYPE ANYTHING
	MOVE	B,0(D)			;MASK ∧ ¬ NAME
	TRNN	A,-1			;SKIP IF PROG NAMED
	TRZ	B,-1			;NO PROG NAMED. SET PROG TO 0
	TLNN	A,-1
	TLZ	B,-1
	CAMN	A,B
FIND2:	PUSHJ	P,TYPEX			;TYPE USER NAME
	ADD	D,[XWD UFDN,UFDN]
	JUMPL	D,FIND1
	CLOSE	TTY,			;FLUSH OUTPUT
	POP	P,LPTBUF		;RESTORE OLD BUFFER  POINTER
	POPJ	P,

FNDERR:	OUTSTR	[ASCIZ/INVALID ITEM
/]
	CLRBFI
	POPJ	P,
	SUBTTL	THINK ABOUT PRIVILEGES

PRVTYP:	PUSH	P,A		;SAVE THE PR BITS
	MOVEI	A,11		;WRITE A TAB
	PUSHJ	P,PUTCHR	;..
	HLLZ	L,0(P)		;GET THE PR BITS (LEFT)
	MOVSI	M,-LPBLL	;GET THE LENGTH OF THE TABLE
	JUMPE	M,PRVTP3	;JUMP IF NO LEFT SIDE BITS
PRVTP1:	TDNN	L,LPBITS(M)	;SEE IF A BIT IS SET
	JRST	PRVTP2		;NOPE
	HRLZ	A,LPBITS(M)	;GET THE PRIV NAME
	PUSHJ	P,SIXOUT	;TYPE SIXBIT
	MOVEI	A," "
	PUSHJ	P,PUTCHR	;WRITE A SPACE
PRVTP2:	AOBJN	M,PRVTP1	;LOOP
PRVTP3:	POP	P,L		;GET THE BITS BACK
	HRLZ	L,L		;GET THE RIGHT SIDE BITS IN THE LEFT
	MOVSI	M,-RPBLL
	JUMPE	M,CPOPJ
PRVTP4:	TDNN	L,RPBITS(M)
	JRST	PRVTP5
	HRLZ	A,RPBITS(M)
	PUSHJ	P,SIXOUT
	MOVEI	A," "
	PUSHJ	P,PUTCHR
PRVTP5:	AOBJN	M,PRVTP4
	POPJ	P,

PRVGET:	MOVEM	A,PHRASE+1	;SAVE OLD PRIV. SET
	MOVEM	A,PHRASE	;SAVE HERE TOO
	JUMPE	A,PRVGT0	;ASK FOR NEW PRIVS
	OUTSTR	[ASCIZ/ADDED/]
	JRST	.+2
PRVGT0:	OUTSTR	[ASCIZ/NEW/]
	OUTSTR	[ASCIZ/ PRIVILEGES:  /]
PRVGT1:	PUSHJ	P,SIXIN		;GET SOME SIXBIT NAME IN B
	MOVEM	A,PATCH		;SAVE THE DELIMITER IN MESDAY
	MOVSI	M,-LPBLL
	JUMPE	M,PRVGT3	;NO FLAGS ON THIS SIDE?
	JUMPE	B,PRVGT7	;FLUSH NULL STRINGS
PRVGT2:	HRRZ	A,LPBITS(M)	;GET THE NAME OF A PRIVILEGE
	CAME	A,B		;COMPARE TO WHAT WE SAW
	AOBJN	M,PRVGT2
	JUMPGE	M,PRVGT3
	HLLZ	A,LPBITS(M)	;GET THE BITS
	JRST	PRVGT5		;SET NEW BITS
PRVGT3:	MOVSI	M,-RPBLL	
	JUMPE	M,PRVGT6	;THIS IS A LOSS
PRVGT4:	HRRZ	A,RPBITS(M)
	CAME	A,B
	AOBJN	M,PRVGT4
	JUMPGE	M,PRVGT6
	HLRZ	A,RPBITS(M)	;GET THE BIT TO SET
PRVGT5:	TRNN	FL,NEGF
	IORM	A,PHRASE+1
	TRNE	FL,NEGF
	ANDCAM	A,PHRASE+1	;SHUT OFF BITS
	JRST	PRVGT7		;LOOK FOR MORE
PRVGT6:	OUTSTR	[ASCIZ/UNKNOWN: /]
	HRLZ	A,B		;GET THE OFFENSIVE NAME
	PUSHJ	P,SIXOUT	;WRITE IT
	OUTSTR	CRLF
PRVGT7:	MOVE	A,PATCH
	CAIE	A,12		;LF STOPS THE WORLD
	JRST	PRVGT1		;LOOK FOR MORE
	MOVE	A,PHRASE+1
	MOVEM	A,INFOS+PRVBIT	;SAVE IN INFOS
	POPJ	P,		;RETURN

SIXIN:	SETZ	B,		;ZERO AN AC
	TRZA	FL,NEGF		;ZERO FLAG FOR -
SIXIN0:	TRC	FL,NEGF		;SET FLAG
SIXIN1:	INCHWL	A		;GET A CHARACTER
	CAIN	A,15
	JRST	SIXIN1		;FLUSH CR
	CAIE	A,40
	CAIN	A,11
	JRST	[JUMPE B,SIXIN1	;IGNORE LEADING BLANKS AND TAB
		POPJ	P,]	;ELSE RETURN
	CAIE	A,","
	CAIN	A,12
	POPJ	P,		;RETURN FOR LF OR COMMA 
	CAIN	A,"-"
	JUMPE	B,SIXIN0
	CAIL	A,"a"
	CAILE	A,"z"
	JRST	.+2
	TRZ	A,40
	CAIG	A,40
	POPJ	P,		;RETURN
	SUBI	A,40
	ANDI	A,77
	TLNE	B,770000	;ANY BITS LEFT IN B?
	JRST	SIXIN1		;NOPE FLUSH EXTRA CHARACTERS
	LSH	B,6
	IOR	B,A
	JRST	SIXIN1		;LOOP

PROTYP:	TDNN	A,[777400,,000000]	;IF ANY OF THESE ARE ON, TYPE SOMETHING
	POPJ	P,
	MOVEI	B,[ASCIZ/	Default protection = /]
	PUSH	P,A		;SAVE THE WORD
	PUSHJ	P,PUTSTR
	LDB	A,[POINT 9,(P),8]	;GET PROTECTION.
	PUSHJ	P,OCTTYP		;TYPE OCTAL
	MOVEI	A,11
	PUSHJ	P,PUTCHR
	MOVE	A,(P)
	TLNN	A,400		;THIS IS INELEGANT, BUT I DON'T REALLY WANT TO
	JRST	PRORET		;THINK ABOUT IT TOO HARD
	MOVEI	B,[ASCIZ/
400	Remote Account/]
	PUSHJ	P,PUTSTR
PRORET:	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR
	POP	P,A
	POPJ	P,

PROGET:	OUTSTR	[ASCIZ/New default protection halfword: /]
	MOVEI	B,0
PROGT1:	INCHWL	A		;GET A CHARACTER
	CAIN	A,15
	JRST	PROGT1		;FLUSH CR
	CAIE	A,40
	CAIN	A,11
	JRST	[JUMPE B,PROGT1	;IGNORE LEADING BLANKS AND TAB
		POPJ	P,]	;ELSE RETURN
	CAIL	A,"0"
	CAILE	A,"7"
	POPJ	P,
	LSH	B,3
	IORI	B,-"0"(A)
	JRST	PROGT1

PTYPE:	TTCALL	3,[ASCIZ/The available privileges are: 
/]
	SETO	A,
	PUSHJ	P,PRVTYP		;TYPE ALL BITS
PRONAM:	OUTSTR	[ASCIZ/
The fields in the default protection word (LH) are:
777000	default proection for new files
000400	Remote account
/]
	POPJ	P,

OCTTYP:	IDIVI	A,10
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,OCTTYP
	HLRZ	A,(P)
	ADDI	A,"0"
	JRST	PUTCHR
	SUBTTL	LIST USER DATUM.
ILIST:	PUSHJ	P,LPTINI	;GET THE LPT.
	POPJ	P,		;NOT THERE
	GETPPN	A,
	PUSHJ	P,TYPPN
	MOVEI	B,[ASCIZ/ requested this listing

/]
	PUSHJ	P,PUTSTR


ITYPE:	MOVE	D,MFDPT
	AOJGE	D,LPTRLS
ILIST1:	PUSHJ	P,TYPEX			;CALL TYPE OUT ROUTINES
	ADD	D,[XWD UFDN,UFDN]
	JUMPL	D,ILIST1
	JRST	LPTRLS			;RELEASE THE LPT IF IN USE


TYPEX:	SKIPE	B,0(D)			;IS THERE A PPN HERE?
	CAMN	B,['  1  1']
	POPJ	P,			;NO. RETURN
	HLRZ	B,1(D)			;MAKE SURE OF VAILD UFD
	CAIE	B,'UFD'
	POPJ	P,			;NOT VALID
	HRRZ	B,3(D)			;GET THE DISK ADDRESS
	MOVEM	B,INRD1			;SAVE
	PUSHJ	P,DOINRD		;READ THE DISK
	JRST	ILIST5			;ERROR
	MOVE	B,[XWD FILE0+INFBAS,INFOS]
	BLT	B,INFOS+4		;BLT SPECIAL RETRIEVAL DATA
	SKIPN	INFOS+LOSPSW		;SKIP IF HE'S GOT PASSWORD
	SKIPE	LPTBUF			;NO PASSWORD. SKIP IF TTY
	JRST	ILIST4			;PASSWORD OR LPT. WRITE IT
	SKIPN	INFOS+PRVBIT		;SKIP IF HE HAS PRIV BITS
	POPJ	P,			;TTY AND NO PASSWORD. SKIP THIS
ILIST4:	MOVE	A,0(D)	
	PUSHJ	P,TYPPN			;WRITE NAME
	MOVEI	A,11
	PUSHJ	P,PUTCHR		;AND TAB
	SKIPN	A,INFOS+LOSPSW		;GET THE PASSWORD
	JRST	ILST4X			;  IF ANY
	PUSHJ	P,SIXOUT		;WRITE
	MOVEI	A,"%"
	SKIPGE	2(D)			;IF REMOTE-ONLY PASSWORD,
	PUSHJ	P,PUTCHR		;  FLAG IT
ILST4X:	SKIPN	LPTBUF			;SKIP IF WE'RE ON THE LPT
	JRST	ILST4A			;ON THE TTY. SHORT MESSAGE
	MOVEI	A,11
	PUSHJ	P,PUTCHR		;WRITE A TAB
	MOVE	A,INFOS+LASDAT		;GET DATE AND TIME
	TLZ	A,400000		;DELETE BIT
	PUSHJ	P,TDOUT			;WRITE TIME AND DATE
	MOVEI	A,"*"
	SKIPGE	INFOS+LASDAT
	PUSHJ	P,PUTCHR		;FLAG ILLEGAL USERS.
ILST4A:	SKIPE	A,INFOS+PRVBIT		;GET THE USER PRV BITS
	PUSHJ	P,PRVTYP		;TYPE PR BITS
	MOVE	A,INFOS+PRVBIT
	ANDCM	A,ALLPRV
	JUMPE	A,ILST4B		;JUMP IF NO MYSTERY PRIVS.
	PUSH	P,A
	MOVEI	B,[ASCIZ/UNKNOWN PRIVILEGES =  /]
	PUSHJ	P,PUTSTR
	POP	P,A
	PUSHJ	P,OCTOUT
ILST4B:	MOVEI	B,CRLF
	PUSHJ	P,PUTSTR		
	MOVE	A,INFOS+DEFPRO
	JRST	PROTYP			;TYPE PROTECTION DATA AND RETURN

ILIST5:	MOVEI	B,[ASCIZ/DISK ERROR READING UFD
/]
	JRST	PUTSTR			;WRITE STRING AND POPJ
	SUBTTL	MODIFY A USER'S INFO ENTRY
MODIFY:	OUTSTR	[ASCIZ/USER = /]
	PUSHJ	P,GETP
	POPJ	P,
	SKIPE	A,PHRASE+1
	SKIPN	PHRASE
	JRST	FNDERR		;MAKE ERROR MESSAGE
	HRL	A,PHRASE
	MOVE	D,MFDPT		;GET POINTER TO MFD
	AOJL	D,MODIF1	;MAKE DIRECT POINTER
	OUTSTR	[ASCIZ/MFD IS EMPTY?
/]
	POPJ	P,
MODIF1:	CAMN	A,(D)		;LOOK
	JRST	MODIF3		;FOUND ONE?
MODIF2:	ADD	D,[XWD UFDN,UFDN]	;FORGE ON
	JUMPL	D,MODIF1		;LOOP
	OUTSTR	[ASCIZ/NO SUCH UFD.
/]
	POPJ	P,
MODIF3:	HLRZ	B,1(D)
	CAIE	B,'UFD'
	JRST	MODIF2		;THIS IS NOT A UFD
	CAMN	A,['  1  1']
	POPJ	P,
	PUSH	P,D		;SAVE POINTER TO UFD
	HRRZ	B,3(D)		;GET THE TRACK ADDRESS
	MOVEM	B,INRD1		;SAVE
	PUSHJ	P,DOINRD	;READ RETRIEVAL
	JRST	ILIST5		;ERROR
	MOVE	A,[XWD FILE0+INFBAS,INFOS]
	BLT	A,INFOS+INFON-1	;GET THE DATA TO A CONVENIENT PLACE
	PUSHJ	P,MTYPE		;TYPE DATA FOR THIS GUY.
	OUTSTR	[ASCIZ/NEW PASSWORD = /]
	PUSHJ	P,GETP		;GET A PASSWORD
	SETZM	PHRASE		;NULL PASSWORD
	MOVE	A,PHRASE	;GET IT
	MOVEM	A,INFOS+LOSPSW	;SAVE IT
	MOVE	A,INFOS+PRVBIT	;GET PRIVILEGES
	PUSHJ	P,PRVGET	;GET A NEW SET OF PRIVILEGES
	PUSHJ	P,PROGET	;GET NEW PROTECTION BITS
	MOVSM	B,INFOS+DEFPRO	;SAVE NEW PROTECTION BITS IN LH
	MOVE	D,(P)
	OUTSTR	[ASCIZ/
DATA FOR THIS USER IS NOW:
/]
	PUSHJ	P,MTYPE
	POP	P,D		;GET D BACK AGAIN
	OUTSTR	[ASCIZ/WRITE THIS NOW? /]
	PUSHJ	P,YORN
	POPJ	P,		;NO
	MOVE	K,(D)		;GET USER NAME
	MOVSI	L,'UFD'
	SETZ	M,
	MOVE	N,GOD
	LOOKUP	DMP,K
	JRST	MODIF4		;CAN'T ENTER
;	SETZM	INFOS+LASDAT+1
;	MOVE	K,[XWD INFOS+LASDAT+1,INFOS+LASDAT+2]
;	BLT	K,INFOS+INFON-1
	MTAPE	DMP,WRINFO	;WRITE DATA INTO FILE
	JRST	MODIF5		;ERROR
	CLOSE	DMP,		;RELEASE FILE
	POPJ	P,

MODIF4:	OUTSTR	[ASCIZ/
UFD LOOKUP FAILED
/]
	POPJ	P,
MODIF5:	CLOSE	DMP,
	OUTSTR	[ASCIZ/INFO WRITE FAILED
/]
	POPJ	P,

MTYPE:	MOVE	A,(D)		;GET THE PPN
	PUSHJ	P,TYPPN
	MOVEI	A,11
	PUSHJ	P,PUTCHR
	SKIPN	A,INFOS+LOSPSW
	JRST	MTYPE1
	PUSHJ	P,SIXOUT
	MOVEI	A,"%"
	SKIPGE	2(D)
	PUSHJ	P,PUTCHR
MTYPE1:	SKIPE	A,INFOS+PRVBIT
	PUSHJ	P,PRVTYP
	MOVEI	B,CRLF
	JRST	PUTSTR
	MOVE	A,INFOS+DEFPRO
	PUSHJ	P,PROTYP	;TYPE PROTECTION PART
	MOVEI	B,CRLF
	JRST	PUTSTR

DOINRD:	MTAPE	DMP,INRD	;READ RETRIEVAL
	POPJ	P,		;ERROR
	AOS	(P)
	MOVEM	A,1(P)
	HRRZ	A,(D)		;GET USER NAME
;	CAIE	A,'REG'		;SPECIAL?
	JRST	DOINR0		;YES.
DOINR1:	SKIPE	A,FILE0+LOSPSW+INFBAS
	MOVE	A,['QRALPH']
	MOVEM	A,FILE0+LOSPSW+INFBAS
DOINR0:	MOVE	A,1(P)		;GET DATA BACK
	POPJ	P,
	SUBTTL	READ UFD
RMFD:	MOVE	A,GOD
	MOVSI	B,'UFD'
	SETZ	C,
	MOVE	D,GOD
	MOVEI	W,UFDN
	ADDM	W,JOBFF		;INCREMENT JOBFF TO LEAVE SOME ROOM
	PUSHJ	P,DREAD
	EXIT			;THIS BETTER NOT HAPPEN. EVER
	SUB	W,[XWD UFDN,UFDN]
	MOVEM	W,MFDPT		;SAVE POINTER TO MFD 
	MOVE	A,GOD
	MOVSI	B,'UFD'
	SETZ	C,
	MOVEI	D,MFDTRK	;1 IS THE TRACK ADDRESS OF MFD
	MOVEI	X,1(W)
	HRLI	X,A		;SOURCE,,DESTINATION IN X
	BLT	X,4(W)		;SAVE THE STUFF
	POPJ	P,		;RETURN
	SUBTTL	DREAD	READ A WHOLE FILE IN DUMP MODE.
;	SET A,B,C,D TO A LOOKUP BLOCK.
;	SKIP RETURN IF OK. W IS IOWD FOR DATA. FILE READ INTO JOBFF
;	NON SKIP: MESSAGE WILL BE TYPED
DREAD:	SETZB	W,X		;ZERO THINGS TO START RIGHT
	LOOKUP	DMP,A		;LOOK FOR THE FILE
	JRST	DREAD1		;FILE NOT FOUND. CODE IN B
	HRR	D,JOBFF		;GET JOBFF
	SUBI	D,1		;MAKE THIS AN IOWD
	MOVE	W,D		;SAVE THE IOWD
	HLRE	C,D		;GET - LENGTH OF FILE 
	MOVN	B,C	 	;GET + FILE LENGTH
	ADDB	B,JOBFF		;RESET JOBFF
	CAMG	B,JOBREL	;IS IT TOO BIG?
	JRST	.+3		;NO. WE'RE OK
	CORE	B,		;MAKE ENOUGH CORE HAPPEN
	JRST	NOCORE		;THIS IS A LOSS
	INPUT	DMP,W		;USE THE IOWD IN W TO READ THE WHOLE
	STATZ	DMP,740000	;CHECK TRANSFER STATUS
	JRST	DREAD2		;LOSING STATUS
	CLOSE	DMP,		;RELEASE THE FILE
	JRST	CPOPJ1		;GIVE THE OK RETURN
DREAD1:	CAME	A,['ALFACT']	;NO MESSAGE IF ACCOUNTING LOSES.
	TRNE	FL,PTYLIN
	JRST	DREAD4
	OUTSTR	[ASCIZ/LOOKUP FAILURE. FILE = /]
	PUSH	P,A
	PUSH	P,B		;SAVE FILE AND CODE
	PUSHJ	P,TYFIL		;WRITE FILE NAME
	OUTSTR	[ASCIZ/; CODE = /]
	HRRZ	A,(P)		;GET FROM STACK
	JRST	DREAD3
DREAD2:	TRNE	FL,PTYLIN
	JRST	DREAD4
	OUTSTR	[ASCIZ/I-O ERROR. FILE = /]
	PUSH	P,A
	PUSH	P,B
	PUSHJ	P,TYFIL
	OUTSTR	[ASCIZ/; STATUS = /]
	GETSTS	DMP,A
DREAD3:	PUSHJ	P,OCTOUT
	OUTSTR	CRLF
	POP	P,B
	POP	P,A
DREAD4:	CLOSE	DMP,
	POPJ	P,
	SUBTTL	INITIALIZE
BEGIN:	RESET			;A GOOD WAY TO START THE DAY
	MOVE	P,[IOWD PDLEN,PDLIST]	;INITIALIZE PDL

	SETOM	CKCODE		;ASSUME LEGITIMATE USER.
	INIT	DMP,217		;GET A DISK CHANNEL FOR USE LATER
	'DSK   '
	0
	JRST	NODISK		;THIS IS TERRIBLE
	PUSHJ	P,TTYINI	;GET A TTY

	DATE	A,		;GET CURRENT DATE
	TIMER	B,		;AND TIME IN TICKS SINCE MIDNITE
	IDIVI	B,74*74		;DIVIDE TICKS TO MAKE MINUTES
	HRL	B,A		;MAKE DATE,,TIME
	MOVEM	B,NOW		;SAVE TIME
	SETO	A,		;SET A TO GET LINE CHARACTERISTICS
	TTCALL	6,A		;GET LINE CHARACTERISTICS
	MOVEM	A,LINCHR	;LINE CHARACTERISTICS WORD
	TLNE	A,DPYBIT+DDBIT	;EITHER DATA DISK OR III?
	TRO	FL,DPYLIN	;YES FLAG IT
	TLNE	A,CTYBIT	;CTY?
	TRO	FL,CTYLIN	;YES
	TLNE	A,PTYBIT
	TROA	FL,PTYLIN	;FLAG A PTY
	JRST	BEGNPT		;THIS IS NOT A PTY.
	TLNE	A,IMPBIT		;IS THIS AN IMP?
	TRC	FL,IMPLIN+PTYLIN	;YES. SET IMP AND NOT PTY.
	MOVEI	A,TTYNUM	;PEEK INTO SYSTEM
	PEEK	A,
	LDB	B,[POINT 9,A,8]	;
	LDB	C,[POINT 9,A,17];
	ADDI	B,1(C)
	LDB	C,[POINT 9,A,26]
	ADDI	B,(C)
	HRRZ	A,LINCHR
	SUBI	A,(B)
	SETZM	PTYPPN		;CLEAR PPN OF OWNER
	SETZM	PTYTJB
	JUMPL	A,BEGNPT	;THIS CAN'T HAPPEN?
	MOVEI	B,PTYJOB
	PEEK	B,
	ADDI	B,(A)
	PEEK	B,
	MOVEM	B,PTYTJB	;JOB NUMBER OF CONTROLLING JOB.
	TLNE	FL,IMPLIN	;IS THIS AN IMP ALREADY?
	JRST	BEGNPT		;YES.  (PTYTJB IS SETUP)
	GETPRV	B,		;USER'S PRIVILEGES
	TLNN	B,1		;LOCAL USER?
	TRC	FL,IMPLIN!PTYLIN		;NO TURN ON IMPLIN
	MOVEI	A,PRJPRG
	PEEK	A,
	ADD	A,PTYTJB
	PEEK	A,
	MOVEM	A,PTYPPN	;PPN OF PTY OWNER.
BEGNPT:	JRST	USRMOD		;NO. RUN THE USER MODE PORTION
	SUBTTL	DO-ALL SCANNER. MAXIMUM UTILITY AND INTOLERANCE.
	
GETP:	SETZB	B,PHRASE	;B = SIXBIT ACC.  PHRASE 1
	SETZB	C,PHRASE+1	;C WILL COUNT PHRASES,, PHRASE 2
	MOVEI	D,40		;WE WILL WAIT 32 SECONDS FOR TYPIN
	INCHWL	A		;SPECIAL. WE'LL WAIT FOREVER
	JRST	GETCK		;OK. WE SAW ONE.

GETCH:	INCHRS	A		;GET ANOTHER, OR SKIP
	POPJ	P,		;NOTHING THERE.  WE MAKE AN ERROR
GETCK:	JUMPE	A,GETCH		;FLUSH NULLS. NO ONE CAN SEND THEM.
	JFCL			;PATCH HERE.
	CAIN	A,12		;LF ENDS EVERYTHING
	JRST	GETHF		;ALL DONE
	CAIN	A,15
	JRST	GETCH		;FLUSH CR
	CAIE	A,40
	CAIN	A,11
	JRST	[    ; JUMPE C,GETCH	;FLUSH BLANKS AND TABS IN FIRST TERM
		JUMPE B,GETCH	;FLUSH LEADING BLANKS AND TABS
		JRST GETHF]	;ASSUME THAT WE'VE SEEN WHOLE TERM
	CAIN	A,175		;IS THIS AN ALTMODE?
	EXIT			;YES. ABORT LOGIN
	CAIN	A,"⊗"		;SPECIAL?
	JRST	SETDDT		;YES GO SET THE DEBUG MODE
	CAIE	A,","		;COMMA DELIMITS PHRASE 1.
	CAIN	A,"/"		;SO DOES SLASH
	JRST	GETHF0		;GO ANNOUNCE THE DELIMITER.
	CAIE	A,"."		;ALLOW THIS AS QUICKIE ALSO -- RPH
	CAIN	A,"|"
	JRST	GETHFA
	CAIN	A,"%"		;SO DOES %
	JRST	GETHF0		;DO THE DELIMITER THING
	CAIL	A,"0"
	CAILE	A,"9"
	JRST	.+2
	JRST	GETCON		;ALLOW DIGITS THROUGH
	CAIL	A,"a"
	CAILE	A,"z"
	JRST	.+2		;NOT LOWER CASE
	TRZ	A,40		;MAKE UPPER CASE
	CAIL	A,"A"
	CAILE	A,"Z"
	JRST	[SETOM PHRASE	;THIS IS A LOSER
		POPJ P,]
GETCON:	SUBI	A,40		;MAKE SIXBIT
	ANDI	A,77		;SCRAPE OFF ANY EXCESS BITS.
	TLNE	B,770000	;DON'T SHIFT TOO FAR
	JRST	GETCH		;TOO FAR.  IGNORE ANYTHING ELSE
	LSH	B,6		;MAKE ROOM.
	IOR	B,A
	JRST	GETCH		;GO GET SOME MORE.

GETHFA:	TRO	FL,NODATE	;TURN ON FLAG
GETHF0:	MOVE	K,A		;SAVE THE DELIMITER HERE.
GETHF:	JUMPE	B,CPOPJ		;NO JUSTIFICATION FOR NOTHING.
	MOVEM	B,PHRASE(C)
	CAIN	A,12
	JRST	CPOPJ1
	SETZB	B,D
	JUMPG	C,SSCAN		;SCAN FOR SERVICE LEVEL
	AOJA	C,GETCH		;INCREMENT TERM COUNTER

SSCAN:	INCHRS	A		;GET A CHARACTER
	POPJ	P,		;NO GOOD
	CAIN	A,12		;LINE FEED?
	JRST	SSCANX		;YES THATS ALL
	CAIN	A,15		;FLUSH CR
	JRST	SSCAN
	CAIE	A,40
	CAIN	A,11
	JRST	SSCAN		;FLUSH BLANK,TAB
	CAIL	A,"0"		;SKIP IF TOO SMALL
	CAILE	A,"9"
	POPJ	P,		; THIS IS A LOSS
	IMULI	D,12		;ACCUMULATE IN D
	ADDI	D,-"0"(A)	;ADD IN DIGIT
	JRST	SSCAN

SSCANX:	JRST	CPOPJ1		;DO THE SKIP RETURN

YORN:	MOVEI	B,74		;60 SECONDS OF WAITING
	CLRBFI			;FLUSH THE WORLD FIRST
YORN0:	MOVEI	A,1		;SLEEP 1 SECOND
	SLEEP	A,		;SLEEP 1 SECOND
	INCHRS	A		;LOOK FOR A CHARACTER	
	JRST	YORN0		;NOT THERE, WAIT
	CLRBFI
	OUTSTR	CRLF
	CAIE	A,"Y"
	CAIN	A,"y"
	JRST	CPOPJ1		;SKIP RETURN FOR "Y"
	CAIE	A,175		;LOOK FOR  ALTMODE
	POPJ	P,		;IS OK
	EXIT			;KILL THE BASTARD

SETDDT:	SKIPN	JOBDDT		;SKIP IF WE HAVE DDT
	POPJ	P,		;ILLEGAL CHARACTER IN SCAN
	OUTSTR	[ASCIZ/(DDT)
/]				;TELL HIM WHERE ITS AT.
	JRST	@JOBDDT		;JUMP TO DDT

CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,			;RETURN

	END	BEGIN